perm filename FUNCTS.PAL[U,VDS]2 blob
sn#300584 filedate 1977-08-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00015 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 .TITLE FUNCTS
C00006 00003 "HERE" - COMMAND INSTRUCTION
C00007 00004 "POINT" - COMMAND INSTRUCTION
C00009 00005 "WHERE" - COMMAND INSTRUCTION
C00012 00006 "TF" - COMMAND INSTRUCTION
C00013 00007 "CLEAR" - COMMAND INSTRUCTION
C00016 00008 "LISTT" - LISTS THE VALUES OF STORED TRANSFORMATION
C00019 00009 "LISTP" - LISTS THE STEPS OF A USER PROGRAM
C00022 00010 "PUNCHT"&"PUNCHP" - SAME AS LISTT&LISTP TO PAPER TAPE
C00023 00011 "PROGS" - LISTS THE NAMES OF ALL USER PROGRAMS
C00025 00012 "STATUS" - PRINTS THE CURRENT STATUS OF PROGRAM EXECUTION
C00028 00013 "FREE" - COMMAND INSTRUCTION
C00030 00014 "EXEC" - COMMAND INSTRUCTION
C00035 00015 "PROCEED","SNGSTP" - COMMAND INSTRUCTIONS
C00037 ENDMK
C⊗;
.TITLE FUNCTS
;START OF TOP LEVEL ARM PROGRAM
START: RESET
MOV #STKTOP,SP ;INITIALIZE STACK
.IFZ LSI
MOV #PARVEC+2,PARVEC;ENABLE PARITY ERROR TRAPS
MOV #BPT,PARVEC+2
MOV #1,PARCSR
.ENDC
MOV #LOCK,R0 ;TRANSFER EIS CONSTANTS FROM ROM TO RAM
MOV #CONS,R1
↓MOV #CONE-CONS/2,R3
MOV (R1)+,(R0)+
SOB R3,.-2
MTPS LOCK ;INIT@∪β1∪5
AA%∨πM'↔$AM)β)+L~∀&lzX%∞≤b.N⊗⊂¬Dα≤9I5%∃¬:4-"
Zα∧≤β∪pi4∃Q0jItC"A→3uB$e`OCK,@#CLKTRP+2~∀%≠⊂≡XJ~"⊗2dy2N≤KZR⊗2bα⊗J⊗α+∀|TT
tDzλ¬q$λ4Q#!!2TtA~⊂k∩)I5α"'→3R5 _3∩6HWc"B)*tB4λ∃⊂p &⊃εE&`Rg&≥∧Sek∧QTh¬E@%dY'∞∩mβ'⊗A→≠$A∪9' ∩J,~R&>ph(&*≥⊂&B
e"fBNαJ hPα33j@∧Qdg⊂*c⊗)QD]`∩EAD IN A COMIAND IN@'Q%+π %≠≤
∀%∃'$∪AαYβ≥M)$
∀%≠↔,∩
+≥$
2IIn∩⊗≤z∩* ~BdtXXB∧5Yh5$Ly`λ λ4r⊂∃ a&"CE MOT #CMN@,R⊃ ;GNLY @→∨=⊗A
∨HA)∨ ↓→-0Aπ∂≠5β⊂~∩_h(&*≥⊂&B
eαVNε∀84(_(4λLyzD≤\Q⊃∪L∃(→d≤B _b∧dXx∀b∧9yTlhAPPMJ:@M∪⊃⊃∪]∧Z:B∧LdλTm¬K∀¬≥¬)→d:Q!∀∀
⊃→TLiA⊂K\Iyuα∧(_4Z∧_d∧,mλK∩∧d→hPhP→*5⊂Mλ5E%MλZ%∩↔8Te≤T
EM∧TλU∃∀z ∧l-:8∀<(Q!∀∃⊂→X∀LtAQ$<⎇H9tkP→Yu0M:¬E∪ ⊃↔5¬%$
Dz∧~(u,lYjE~∧xd¬≥$_90hP→*5⊂Mλ5DαE&¬∩XK8[∧,≥ZHR∧5Yh5$LyaPPL_H@J≤X≠∧
∀uJ5K89D,
$λ∃∀=YXTu" I∃≥" xd2¬:H∀≤XQ!∀∃⊂→X∀LtAQ hTIyd+P→Yu0J8yt|$+∃E∪λ↔8∀dbλItt*D
5$⎇∧ T|t~Iu⊂h!→%≥⊂~λ2e%~λU∃⊂Q!∀$A∀4l
λ~$:[%J5K9HT
4T
5$94∧≤dX~ hP→Yu0J6%Dα≤9I5%∃¬6 K\9HT
∩λ9D|≤4 ∀u$Z*%-¬D
d,≥Iz hP→Yu0J89D]%*¬3∩d∧84d]J*hP→ E h!Q%
,Z+∪PJh~4≤M!∃rrxQ!PS\YhB∧|d
D⎇α HU4,D
4-
XYd≤(Q cZ)λU∀*$∧ααjλ9tll→hB∧Lj:E∃,:I∀|pQ$hS:I∧M~
)u-$→hU~¬8ZE~∧∀λtM4Yd¬%∀→j44⎇)T∧-
X→B¬$t
DD*
$-≤YjB¬∧z9∃$LyaPS\xd¬$DTλ∃∀jd∧¬$DT tte∀λ∃∀=YXTu"
(U
,~(T"∧iz"¬$ ~2∧5Yh5$Lyd∧M~λ∀¬¬%!Q#]$t
DD*
J$u8iu∀l~I∀|raQ hS:(T<MSTERS ARE AVAILABLE FOR USE
HERE: MOV (R4),R3 ;GET PTR TO TRANS SYMBOL BLOCK
JSR PC,HERESB ;READ AND STORE POSITION
BCC .+6 ;ERROR?
JMP @#TYPERR
MOV (R3),R0 ;PERMIT EDITING OF TRANSFORM
JMP MODTRN
;END OF "HERE"
;"POINT" - COMMAND INSTRUCTION
;THIS COMMAND IS USED FOR INITIALIZING AND EDITING THE X,Y,Z,O,A,T
;VALUES OF A SPECIFIED TRANSFORM. THE TRANSFORMATION POINTER IS
;ASSUMED TO BE IN THE ARGUMENT LIST ON THE STACK. IF THE TRANS IS TO
;BE SET EQUAL TO THE VALUE OF ANOTHER TRANSFORM, THIS SECOND TRANS PTR
;MUST ALSO BE ON THE STACK.
;REGISTERS USED:
; ALL REGISTERS ARE AVAILABLE FOR USE
POINT: CLR R3
MOV (R4)+,R2 ;PTR TO TRANS SYMBOL BLOCK
MOV (R2),R0 ;PTR TO DATA
BNE 10$
MOV #12.,R0 ;GET A BLOCK OF F.S. IF NOT DEFINED
JSR PC,GETBLK
BCS 45$ ;NO ROOM?
MOV R0,(R2) ;SET PTR TO TRANS DATA AREA
MOV #SMPTRN,R3 ;INIT. TRANSFORM TO REASONABLE POS
10$: MOV (R4),R1 ;SET TRANS EQUAL TO ANOTHER TRANS?
BEQ 20$
MOV (R1),R3 ;YES
BEQ 40$ ;ERROR IF NO DATA
20$: TST R3 ;INITIALIZE TRANS?
BEQ 30$ ;NO
MOV R0,R1
MOV #12.,R4
MOV (R3)+,(R1)+
SOB R4,.-2
30$: JMP @#MODTRN ;PERMIT EDITING OF TRANS
40$: MOV #NOTDAT,R1 ;SIGNAL NO DATA FOUND WHEN EXPECTED
45$: JMP @#TYPERR
;END OF "POINT"
;"WHERE" - COMMAND INSTRUCTION
;THIS COMMAND IS USED FOR TYPING OUT THE CURRENT ARM POSITION. THE
;ARM POSITION IS PRINTED BOTH IN EULER ANGLES AND JOINT ANGLES. THE
;HAND OPENING IS ALSO LISTED IN INCHES. AS A SIDE AFFECT, "WHERE"
;UPDATES "CTRANS" WITH THE CURRENT ARM TRANSFORM. NO ARGUMENTS ARE
;REQUIRED BY THIS ROUTINE.
;REGISTERS USED:
; ALL REGISTERS ARE AVAILABLE FOR USE
WHERE: CLR R0 ;READ JT. ANGLES/HAND OPENING
MOV #7,R1 ;SEVEN CHANNELS IN ALL
MOV #JANGLE,R2
JSR PC,ANGLES ;PUT INTO "JANGLE"
BCC WHER1 ;BRANCH IF NO ADC ERROR
JSR PC,TYPERR
BR WHEDNE ;EXIT
WHER1: MOV #HTRAN2,SG ;TYPE OUT THE COLUMN HEADER
JSR PC,LINOUT
MOV #CTRANS,R0 ;PUT CURRENT TRANSFORM IN HERE
MOV #JANGLE,R1 ;GET JOINT ANGLES FROM HERE
JSR PC,UPDATE ;CONVERT JT. ANGLES TO TRANSFORM
MOV #CTRANS,R0 ;TYPE OUT THIS TRANSFORM
JSR PC,PTRANS
MOV #WHERC1,SG ;TYPE OUT JOINT ANGLES COLUMN HEADER
JSR PC,LINOUT
MOV #OUTBUF,SG ;CONVERT JOINT ANGLES TO ASCII
MOV #JANGLE,R2 ;HERE ARE THE ANGLES
MOV #6,R3 ;PRINT 6 ANGLES AND HAND OPENING
WHER2: MOV (R2)+,R0 ;GET AN ANGLE
JSR PC,PRTANG ;CONVERT TO ASCII
MOVB #40,(SG)+ ;PUT IN A SPACE CHARACTER
SOB R3,WHER2
MOV (R2),R0 ;CONVERT THE HAND OPENING TO INCHES
JSR PC,PRTDIS
MOV #OUTBUF,SG ;PRINT THE ASC STRING
JSR PC,LINOUT
WHEDNE: RTS PC
WHERC1: .ASCII / JT 1 JT 2 JT 3 JT 4 JT 5 /
.ASCIZ /JT 6 HAND/
.EVEN
;END OF "WHERE"
;"TF" - COMMAND INSTRUCTION
;THIS ROUTINES INITIALIZES THE VALUE OF ONE TRANSFORM. IT REQUIRES
;AS ITS ARGUMENTS, THE TRANSFORM NAME AND ITS 6 DEFINING VALUES.
;REGISTERS USED:
; ALL REGISTERS ARE AVAILABLE FOR USE
TF: MOV (R4)+,R2 ;GET PTR TO TRANS SYMBOL BLOCK
MOV (R2),R0 ;GET PTR TO DATA
BNE TF2
MOV #12.,R0 ;GET A BLOCK OF F.S. IF NOT DEFINED
JSR PC,GETBLK
BCC .+6 ;NO ROOM?
JMP @#TYPERR
MOV R0,(R2) ;SET PTR TO TRANS DATA AREA
TF2: MOV R4,R1 ;CONVERT EULER ANGLES TO TRANFORM
JMP @#UNEUL ;DO CONVERSION
;END OF "TF"
;"CLEAR" - COMMAND INSTRUCTION
;THIS COMMAND IS USED FOR RE-INITIALIZING THE ARM PROGRAM. IT DOES
;THIS BY ZEROING ALL VARIABLE WORDS FROM "ZAPSTR" TO "ZAPEND". IT ALSO
;RESETS THE LOW CORE TRAP VECTORS. NO ARGUMENT IS REQUIRED BY THIS
;ROUTINE, HOWEVER RE-CONFIRMATION OF THE CLEAR COMMAND IS REQUESTED.
;REGISTERS USED:
; ALL REGISTERS ARE AVAILABLE FOR USE
CLEAR: MOV #SURE,SG ;REAFFIRM COMMAND REQUEST
JSR PC,INIT ;CLEAR IF REQUESTED
MOV #CLRFIN,SG ;TELL EVERYONE IT'S DONE
BCC .+6
MOV #CANCLR,SG ;CANCEL CLEAR COMMAND
JMP LINOUT
;SUBR TO INITIALIZE TRAP VECTORS AND ZAP AREA
INIT: JSR PC,TYPSTR ;INPUT RESPONSE
MOV #INBUF,SG
JSR PC,INSTR
CMPB #' ,(SG)+ ;IGNOR LEADING SPACE CHARACTERS
BEQ .-4
CMPB #'Y,-1(SG) ;"Y" ?
BNE 2$
CMPB #' ,(SG)+ ;IGNOR TRAILING SPACE CHARACTERS
BEQ .-4
TSTB -1(SG) ;THIS SHOULD BE A NULL
BNE 2$
.IFZ LSI
MOV @#14,-(SP) ;SAVE DDT BPT
MOV @#16,-(SP)
.ENDC
MOV #8*4,R0 ;FILL LOW CORE TRAPS
MOV #8,R1 ;NUMBER OF TRAPS
1$: MOV #HLT,-(R0)
MOV R0,R2
MOV R2,-(R0)
SOB R1,1$
.IFZ LSI
MOV (SP)+,@#16
MOV (SP)+,@#14
.ENDC
MOV #ZAPEND-ZAPSTR/2,R0 ;NUMBER OF WORDS TO ZERO
MOV #ZAPSTR,R1 ;START CLEARING AT THIS LOCATION
CLR (R1)+
SOB R0,.-2
BR .+4
2$: SEC
RTS PC
SURE: .ASCIZ /ARE YOU SURE (Y,N)? /
CLRFIN: .ASCIZ /ARM PROGRAM RE-INITIALIZED, ALL FREE STORAGE RECLAIMED/
CANCLR: .ASCIZ /CLEAR COMMAND ABORTED/
.EVEN
;END OF "CLEAR"
;"LISTT" - LISTS THE VALUES OF STORED TRANSFORMATION
;LISTS UP TO EIGHT TRANSFORMATIONS THAT ARE SPECIFIED BY THE USER.
;IT IS ASSUMED THAT THE TRANSFORMATIONS SYMBOL BLOCK POINTERS ARE
;ON THE STACK. IF NO TRANSFORMATIONS ARE SPECIFIED, ALL EXISTING
;TRANSFORMATIONS ARE LISTED.
;REGISTERS USED:
; ALL REGISTERS ARE AVAILABLE FOR USE
LISTT: MOV #HTRANS,SG ;PRINT THE HEADER
JSR PC,LINOUT
CLR @#ISPNHT ;INDICATE "LISTT" INSTRUCTION
LSTSTR: CLR R3 ;# OF TRANS' PRINTED
MOV #8.,R2 ;LIMITED LIST OF 8 MAX
LISTT1: MOV (R4)+,R0
BEQ DNTPTR
MOV @#ISPNHT,R1 ;PRINT ALL SPECIFIED TRANSFORMS
JSR PC,PTRTRN
INC R3 ;ONE MORE TRANS PRINTED
DNTPTR: JSR PC,TICKLE ;ABORT?
BCS LSTTER
SOB R2,LISTT1
TST R3 ;PRINT ALL TRANS' IF NONE SPECIFIED
BNE LSTDNE
LSTALL: MOV #32.,R2 ;CHECK ALL 32. HASH BUCKETS FOR TRANS
MOV #VARTAB,R3 ;PTR TO FIRST BUCKET
10$: MOV (R3)+,R4 ;GET FIRST POINTER
BEQ 40$
20$: BITB #TRANS,TYPBIT(R4) ;CHECK IF TRANS VARIABLE
BEQ 30$
MOV R4,R0 ;GOT A TRANS, PRINT IT
MOV @#ISPNHT,R1
JSR PC,PTRTRN
30$: JSR PC,TICKLE ;ABORT?
BCS LSTTER
MOV LINK(R4),R4 ;NEXT ITEM IN BUCKET
BNE 20$
40$: SOB R2,10$ ;REPEAT FOR ALL BUCKETS
BR LSTDNE
LSTTER: JSR PC,TYPERR
LSTDNE: TST @#ISPNHT ;NEED MORE BLANK TAPE?
BEQ .+6
JSR PC,NULLS
RTS PC
;END OF "LISTT"
;"LISTP" - LISTS THE STEPS OF A USER PROGRAM
;LISTS THE SPECIFIED STEPS OF A USER PROGRAM. IF NO FIRST STEP IS
;SPECIFIED, STEP ONE IS ASSUMED. IF NO LAST STEP IS SPECIFIED,
;PRINTING IS CONTINUED UNTIL THE END OF THE PROGRAM IS ENCOUNTERED.
;THE ARGUMENTS FOR THIS ROUTINE ARE ASSUMED TO BE ON THE STACK IN THE
;FOLLOWING ASCENDING ORDER: PROGRAM PTR, 1ST STEP, LAST STEP.
;REGISTERS USED:
; ALL REGISTERS ARE AVAILABLE FOR USE
LISTP: CLR @#ISPNHP ;INDICATE "LISTP"
LSPSTR: MOV (R4)+,R0 ;PTR TO PROGRAM SYMBOL BLOCK
MOV R0,@#LPROG
MOV #LSTPMS,SG ;TYPE PROGRAM NAME
JSR PC,TYPSTR
MOV #OUTBUF,SG
JSR PC,PACNMS
MOV #OUTBUF,SG
JSR PC,LINOUT
MOV R0,R1 ;PTR TO PROGRAM SYMBOL BLOCK
TST (R1) ;ANY STEPS DEFINED?
BEQ LSTPDN
MOV (R4)+,R2 ;FIRST STEP NUMBER
BGT .+6
MOV #1,R2 ;DEFAULT = STEP 1
MOV (R4)+,R3 ;FINAL STEP NUMBER
BGT .+6
MOV #77777,R3 ;DEFAULT = LAST PROGRAM STEP
SUB R2,R3 ;NUMBER OF STEPS TO PRINT-1
BGE LISTP2
MOV #BADSTP,R1 ;SIGNAL ERROR IF FINAL<FIRST
BR LSTPER
LISTP2: INC R3
MOV R2,R4 ;GET FIRST REQUESTED STEP
LISTP3: MOV (R1),R1
BEQ LSTPDN ;NOTHING TO DO IF PAST END
SOB R4,LISTP3
LISTP4: MOV R2,R0 ;PRINT THE REQUESTED STEPS
JSR PC,PSTEP
INC R2 ;INCREASE STEP NUMBER
MOV (R1),R1
BEQ LSTPDN ;DONE IF END OF PROGRAM
JSR PC,TICKLE ;ABORT?
BCS LSTPER
SOB R3,LISTP4
BR LSTPDN
LSTPER: JSR PC,TYPERR
LSTPDN: JSR PC,CRLF
TST @#ISPNHP ;NEED MORE BLANK TAPE?
BEQ .+6
JSR PC,NULLS
RTS PC
LSTPMS: .ASCIZ /DEFPRO /
.EVEN
;END OF "LISTP"
;"PUNCHT"&"PUNCHP" - SAME AS LISTT&LISTP TO PAPER TAPE
;THESE ROUTINES ARE IDENTICAL TO "LISTT" AND "LISTP" EXCEPT THAT
;NO HEADERS ARE TYPED OUT AND INSTEAD NULL CHARACTERS ARE PRINTED
;BEFORE AND AFTER THE DATA TO PROVIDE SOME BLANK LEADER.
;REGISTERS USED:
;
; ALL REGISTERS ARE AVAILABLE FOR USE
PUNCHT: JSR PC,NULLS ;PUNCH OUT A LEADER TAPE
MOV #-1,@#ISPNHT ;INDICATE PUNCHT COMMAND
JMP LSTSTR ;NOW JUST LIKE "LISTT"
PUNCHP: JSR PC,NULLS ;PUNCH OUT A LEADER TAPE
MOV #-1,@#ISPNHP ;INDICATE PUNCHT COMMAND
JMP LSPSTR ;NOW JUST LIKE "LISTP"
;END OF "PUNCHT"&"PUNCHP"
;"PROGS" - LISTS THE NAMES OF ALL USER PROGRAMS
;THIS ROUTINE LISTS THE NAMES OF ALL USER PROGRAMS THAT HAVE AT
;LEAST ONE PROGRAM STEP DEFINED. IT REQUIRES NO ARGMENTS.
;REGISTERS USED:
; ALL REGISTERS ARE AVAILABLE FOR USE
PROGS: MOV #32.,R2 ;CHECK ALL 32. HASH BUCKETS FOR PROGS
MOV #VARTAB,R3 ;PTR TO FIRST BUCKET
MOV #" ,@#OUTBUF
1$: MOV (R3)+,R4 ;GET FIRST POINTER
BEQ 4$
2$: BITB #PROG,TYPBIT(R4);CHECK IF PROGRAM NAME
BEQ 3$
TST (R4) ;ANY PROG STEPS DEFINED?
BEQ 3$ ;NO
MOV R4,R0 ;GOT A PROGRAM NAME, PRINT IT
MOV #OUTBUF+2,SG
JSR PC,PACNMS
MOV #OUTBUF,SG
JSR PC,LINOUT
3$: JSR PC,TICKLE ;ABORT?
BCS PABORT
MOV LINK(R4),R4 ;NEXT ITEM IN BUCKET
BNE 2$
4$: SOB R2,1$ ;REPEAT FOR ALL BUCKETS
BR PROGDN
PABORT: JSR PC,TYPERR
PROGDN: RTS PC
;END OF "PROGS"
;"STATUS" - PRINTS THE CURRENT STATUS OF PROGRAM EXECUTION
;THIS ROUTINE LISTS THE LEVELS OF "GOSUB" CALLS THAT ARE NOW ACTIVE
;AND THE NUMBER OF PROGRAM LOOP EXECUTED AND THOSE REMAINING.
;REGISTERS USED:
; ALL REGISTERS ARE AVAILABLE FOR USE
STATUS: MOV #SUBSTK+2,R3 ;SUBR STACK
MOV #STAHDR,SG ;PRINT HEADER
JSR PC,LINOUT
MOV #" ,@#OUTBUF
1$: MOV #OUTBUF+2,SG
MOV -(R3),R0 ;GET SUBR NAME
BEQ 4$
JSR PC,PACNME ;SAVE IN OUTBUF
MOV -(R3),R2 ;RETURN ADDR
BEQ 3$
MOV (R0),R1 ;COMPUTE STEP NUMBER
CLR R0
BR .+4
2$: MOV (R1),R1 ;KEEP MOVING
INC R0
CMP R1,R2 ;FOUND STEP?
BNE 2$ ;NO
MOVB #' ,(SG)+
JSR PC,PTSINT ;YES, CONVERT TO ASCII
3$: MOV #OUTBUF,SG
JSR PC,LINOUT
CMP R3,@#SUBPTR ;END OF LIST?
BGT 1$ ;NO
4$: MOV #LOPHDR,SG ;TYPE OUT NUMBER OF LOOPS EXECUTED
JSR PC,TYPSTR
MOV #OUTBUF,SG
MOV @#LOPCNT,R0
BIC #100000,R0
JSR PC,PTSINT
MOV #OUTBUF,SG
JSR PC,LINOUT
MOV #LOPHD2,SG ;TYPE OUT NUMBER OF LOOPS REMAINING
JSR PC,TYPSTR
MOV #INFMES,SG
MOV @#EXECNT,R0
BMI 5$
MOV #OUTBUF,SG
JSR PC,PTSINT
MOV #OUTBUF,SG
5$: JSR PC,LINOUT
RTS PC
STAHDR: .ASCIZ /RTN LAST STEP/
LOPHDR: .ASCIZ /
NUMBER OF LOOPS EXECUTED = /
LOPHD2: .ASCIZ /NUMBER OF LOOPS REMAINING = /
INFMES: .ASCIZ /INFINITE/
.EVEN
;END OF "STATUS"
;"FREE" - COMMAND INSTRUCTION
;THIS ROUTINE TYPES OUT THE AMOUNT OF FREE STORAGE SPACE THAT IS
;NOT CURRENTLY BEING USED. NO ARGUMENTS ARE REQUIRED.
;REGISTERS USED:
; ALL REGISTERS ARE AVAILABLE FOR USE
FREE: CLR R5 ;NUMBER OF FREE BYTES
MOV #10000.,R0 ;100% FREE?
TST @#FSPTR
BEQ ALLFRE ;YES
MOV #FREEST+2,R2 ;START ADDING FROM HERE
MOV @#HICORE,R4 ;END OF F.S.
FREELP: MOV (R2),R3 ;NEXT BOUNDARY TAG
BEQ FREEER ;CAN'T EVER BE THIS
BPL MOREFR ;>0 INDICATES NOT BEING USED
NEG R3 ;ON TO NEXT
BR NXTBLK
MOREFR: ADD R3,R5 ;ADD TO FREE SUM
NXTBLK: MOV R2,R1 ;CHECK FOR VALID BOUNDARY TAGS
ADD R3,R2
CMP (R1),-2(R2) ;HI=LOW?
BNE FREEER
CMP R4,R2 ;END OF F.S.?
BHI FREELP
SUB #FREEST,R4 ;TOTAL SIZE OF F.S AREA
TST -(R4)
MUL R5,R0 ;COMPUTE PERCENTAGE FREE
DIV R4,R0
ALLFRE: MOV #FREMES,SG ;TYPE OUTPUT MESSAGE
JSR PC,TYPSTR
MOV #OUTBUF,SG ;CONVERT PERCENTAGE TO ASCII
JSR PC,PTSHUN
MOVB #45,(SG)+ ;%
CLRB (SG)
MOV #OUTBUF,SG
JSR PC,LINOUT
BR FREDNE
FREEER: MOV #BADFRE,R1 ;SAY F.S. AREA IN WRONG FORMAT
JSR PC,TYPERR
FREDNE: RTS PC
FREMES: .ASCIZ /UNUSED FREE STORAGE = /
.EVEN
;END OF "FREE"
;"EXEC" - COMMAND INSTRUCTION
;THIS COMMAND IS USED FOR INITIATING ARM MOTION PROGRAMS. IT
;REQUIRES THREE ARGUMENTS: A USER PROGRAM NAME, A LOOP COUNT, AND
;A STARTING STEP NUMBER FOR THE FIRST PASS. IF THE PROGRAM NAME IS
;OMITTED, THE LAST PROGRAM EXECUTED IS AGAIN RUN. IF THE COUNT IS
;MISSING, ONE PASS IS ASSUMED. A PASS ENDS WHENEVER A "STOP"
;INSTRUCTION IS ENCOUNTERED. FOR MULTIPLE PASS COMMANDS, THE STOP
;MESSAGE IS SUPPRESSED UNTIL THE FINAL PASS IS COMPLETED.
;IF THE STARTING STEP NUMBER IS OMITTED, EXECUTION BEGINS
;WITH THE FIRST PROGRAM INSTRUCTION.
;REGISTERS USED:
; ALL REGISTERS ARE AVAILABLE FOR USE
EXEC: CLR @#ARMS ;CLEAR ALL FLAGS
MOV (R4)+,R2 ;PROGRAM PTR
BNE 1$
MOV #NOPROG,R1 ;ERROR CODE IF NO PROGS EXECUTED YET
MOV @#SUBSTK,R2 ;RE-TRY LAST PROGRAM
BNE 1$
JMP EXECER
1$: MOV R2,@#SUBSTK ;SET-UP SU@ROUTINE STACK
MOV #SUBSTK-2,@#SUBPTR
MOV #NULPRG,R1 ;ERROR MESSAGE FOR NO PROGRAM STEPS
MOV (R2),R2 ;PTR TO FIRST STEP TO EXECUTE
BNE .+6
JMP EXECER
MOV (R4)+,R0
BNE .+6
MOV #1,R0 ;DEFAULT = 1 PASS
MOV R0,@#EXECNT ;PASS COUNT
CLR @#LOPCNT
MOV (R4)+,R0 ;GET STARTING STEP NUMBER
DEC R0
BLE 3$ ;START WITH FIRST STEP
2$: MOV (R2),R2 ;MOVE DOWN TO STARTING STEP
BEQ .+4 ;CANT MOVE PAST END
SOB R0,2$
3$: MOV R2,@SUBPTR ;SAVE PTR TO FIRST STEP TO EXEC
CLR @#NSPEED ;NORMAL SPEED
CLR @#PSPEED
CLR @#CONFIG ;NO SPECIAL CONFIGURATION
CLR @#MODES ;NO PARTICULAR SERVO MODES
CLR @#PMODES
CLR @#JTBITS ;NO SPECIAL JT IN TOLERANCE BITS
EXECST: CLR R0 ;READ CURRENT JT. ANGLES+HAND OPENING
MOV #7,R1 ;SEVEN CHANNELS IN ALL
MOV #DANGLE,R2 ;SAVE IN HERE
JSR PC,ANGLES
BCS EXECER ;BRANCH IF ADC DEAD
MOV #DACVAL,R0 ;INIT. DACS TO THE CURRENT POSITION
JSR PC,TODAC
JSR PC,REFRESH
MOV #NEWDAC,R0 ;NEWDAC ← DACVAL
MOV #DACVAL,R1
MOV #7,R2
1$: MOV (R1)+,(R0)+
SOB R2,1$
CLR @#BRAKES ;RESET ALL HARDWARE BITS
MOV #SWAIT,@#WAITNG ;SET START WAIT COUNT
MTPS UNLOCK ;LET THE CLOCK INTERRUPT
CLKON
MOV #DANGLE,R0 ;DETERMINE CURRENT ARM CONFIGURATION
JSR PC,FLAGS
MOV @SUBPTR,R4 ;ADDR. OF STEP TO EXECUTE
ADD #2,@#SUBPTR
BR TSTSTP
TOPER: INC @#EXECNT
TOTOP: MOV @SUBSTK,R3 ;RESTART AT TOP OF PROGRAM
MOV #SUBSTK,@#SUBPTR;RESET SUBR CALL STACK
GOSTEP: MOV (R3)+,R4 ;NEXT STEP TO EXECUTE
MOV (R3)+,R1 ;PTR TO MOTION FUNCTION
BIC #1,R1 ;DELETE ANY LABEL MARKERS
JSR PC,@(R1)+ ;EXECUTE MOTION FUNCTION
TST @#ARMS ;ANY ERROR BITS SET?
BNE TELSTP ;YES
TSTSTP: MOV R4,R3 ;END OF PASS?
BNE GOSTEP
INC @#LOPCNT
DEC @#EXECNT ;LAST PASS?
BGT TOTOP
BMI TOPER ;INFINITE LOOP
MOV #FINI,R1 ;SIGNAL ALL DONE
CLR @#ARMS
BR .+6
TELSTP: MOV #UHALT,R1 ;PRINT ERROR MESSAGE
SUB #2,@#SUBPTR ;SAVE PTR TO NEXT STEP
MOV R4,@SUBPTR
EXECER: MOV #-1,R0 ;SET ALL OF THE BRAKES
JSR PC,SETBRK
CLKOFF ;STOP THE CLOCK INTERRUPTS
MTPS LOCK
JMP TYPERR ;TYPE ERROR AND RETURN
;END OF "EXEC"
;"PROCEED","SNGSTP" - COMMAND INSTRUCTIONS
;THESE COMMANDS ARE USED FOR CONTINUING THE EXECUTION OF AN ARM
;PROGRAM AFTER IT HAS BEEN TERMINATED BY EITHER A "PAUSE" COMMAND
;OR ANY ONE OF A NUMBER OF ERROR CONDITIONS. ONLY TERMINATION
;CONDITIONS THAT LEAVE THE "CANPRO" BIT IN THE ARM STATUS WORD
;( "ARMS" ) ON PERMIT THESE FUNCTIONS TO OPERATE. NO ARGUMENTS
;ARE REQUIRED BY THESE ROUTINES.
;REGISTERS USED:
; ALL REGISTERS AVAILABLE FOR USE
PROCED: CLR R0 ;ARMS←0 IF CAN PROCEED
MOV #CNTPRO,R1 ;ERROR MESSAGE OTHERWISE
BR TRYGO
SNGSTP: MOV #CANPRO,R0 ;ARMS←CANPRO IF CAN PROCEED
MOV #CNTSGS,R1
TRYGO: BIT #CANPRO,ARMS ;CHECK IF PROCEEDING PERMITTED
BEQ NOPROC ;BRANCH IF NOT OK
MOV R0,@#ARMS
JMP EXECST ;GO CONTINUE EXECUTION
NOPROC: JMP TYPERR ;ELSE TYPE ERROR MESSAGE
;END OF "PROCED","SNGSTP"